(*****************************************************************************
 * Delphi Plug-in Framework (DPF)
 * Copyright (C) 2006-2007 Tao Yuan
 *
 * The contents of this file are subject to the Mozilla Public License
 * Version 1.1 (the "License"); you may not use this file except in compliance
 * with the License. You may obtain a copy of the
 * License at http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
 * the specific language governing rights and limitations under the License.                                                               }
 *
 * The Initial Developer of the Original Code is Tao Yuan. Portions created by
 * Tao Yuan are Copyright (C) Tao Yuan (taoy.cn att gmail dott com)
 * All rights reserved.
 *****************************************************************************)
 
unit RDStandardPluginLoader;

interface

uses
  Rcl,
  RDPluginService, RDPluginManager, RDPluginRegistry, RDConsts,
  RDExceptions, LogLab;

type
  TStandardRegisterPlugin = function: IPlugin; stdcall;
  TStandardExitProcedure = procedure; stdcall;

  TPluginResourceLoader = class;

  TResourceFilter = class;
  TStandardPluginLoader = class(TPluginLoader)
  private
    log: ILog;
    libCacheFolder: string;
    libCacheFolderInitialized: Boolean;
    libraryCache: IStrStrMap;

    libUrls: IStrList;
    libUrl: string;
    libHandle: Integer;

    publicImports,
    privateImports: array of IPluginDescriptor;
    resourceLoader: TPluginResourceLoader;
    
    RegisterProc: TStandardRegisterPlugin;
    ExitProcedure: TStandardExitProcedure;
    FPluginInfo: TPluginInfo;
    probeParentLoaderLast: Boolean;
    resourceFilters: IStrMap;
    procedure collectFilters;
    procedure collectImports;
    function findResource(name: string; requestor: TStandardPluginLoader; seen:
        IStrSet): string; overload;
    function getUrls(manager: TPluginManager; descr: IPluginDescriptor;
        existingUrls: IStrList): IStrList; overload;
    function getUrls(manager: TPluginManager; descr: IPluginDescriptor): IStrList;
        overload;
    function isResourceVisible(name: string; url: string; requestor:
        TStandardPluginLoader): Boolean;
  protected
    function findResource(name: string): string; overload; override;
  public
    constructor Create(aManager: TPluginManager; descr: IPluginDescriptor);
        override;
    destructor Destroy; override;
    function newPluginInstance: IPluginInfo; override;
    procedure pluginsSetChanged; override;
    procedure setProbeParentLoaderLast(value: Boolean);
  end;

  TPluginResourceLoader = class(TURLLoader)
  private
    log: ILog;

  protected
    function findResource(name: string): string; override;
  public
    constructor Create(urls: IStrList);
    destructor Destroy; override;
    class function get(manager: TPluginManager; descr: IPluginDescriptor):
        TPluginResourceLoader;
  end;

  TResourceFilter = class(TObject)
  private
    entries: IStrSet;
    isPublic: Boolean;
  public
    constructor Create(lib: ILibrary);
    function isResourceVisible(resPath: string): Boolean;
    function isVisible(name: string): Boolean;
  end;

implementation  

uses
  Windows, SysUtils,
  DPFLog;

const
  C_REGISTER_PLUGIN = 'RegisterPlugin';
  C_UNREGISTER_PLUGIN = 'UnRegisterPlugin';

resourcestring
  RsEErrEmptyExt = 'Extension may not be empty';
  RsEPluginPackageNotFound = 'Plugin package not found: %s';
  RsERegisterPluginNotFound = 'Plugin function %0:s not found in %1:s';
  RsERegisterPluginFailed = 'Calling %0:s in %1:s failed';

constructor TStandardPluginLoader.Create(aManager: TPluginManager; descr:
    IPluginDescriptor);
var
  I: Integer;
  libPath,
  libPaths: string;
begin
  inherited Create(aManager, descr);
  log := DPFLog.LogFactory.getLogger(Self);
  libUrls := getUrls(aManager, descr);

  for I := 0 to libUrls.Size - 1 do
  begin
    libPath := libUrls.Items[I];//Rcl.FileUtils.IncludeSlash(libUrls.Items[I]);
    if Rcl.FileUtils.IsFile(libPath) then
//      if Rcl.Str.IsEqual(ExtractFileName(libPath), descr.getPluginClassName) then
    begin
      libUrl := libPath;
      Break;
    end;
//    libPaths := libPath + CrLf + libPath;
//    libUrl := libPath + descr.getPluginClassName;
//    if Rcl.FileUtils.IsFile(libUrl) then
//      Break
//    else
//      libUrl := '';
  end;
  if libUrl = '' then
    raise Exception.Create('Not found plug-in (id: ' + descr.getId + ') library in '
        + libPath + CrLf + '!');
  collectImports;
  resourceLoader := TPluginResourceLoader.get(aManager, descr);
  collectFilters;
//  libraryCache = new HashMap;
  libHandle := 0;
end;

destructor TStandardPluginLoader.Destroy;
begin
  FreeAndNil(resourceLoader);

  if libHandle <> 0 then
  begin
    ExitProcedure;
    try
      FreeAndNil(FPluginInfo);
    except

    end;
    FreeLibrary(libHandle);
    libHandle := 0;
  end; 
  inherited;
end;

procedure TStandardPluginLoader.collectFilters;
var
  it: IIntfIterator;
  lib: ILibrary;
begin
  if (resourceFilters = nil) then
      resourceFilters := TStrHashMap.Create
  else
      resourceFilters.clear;

  it := getPluginDescriptor.getLibraries.First;
  while it.HasNext do
  begin
    Supports(it.Next, ILibrary, lib);
    resourceFilters.Items[getPluginManager.getPathResolver.resolvePath(lib,
        lib.getPath)] := TResourceFilter.Create(lib);
  end;
end;

procedure TStandardPluginLoader.collectImports;
var
  publicImportsMap,
  privateImportsMap: IStrIntfMap;
  it: IIntfIterator;
  it1: IIntfIterator;
  I: Integer;
  pre: IPluginPrerequisite;
  preDescr: IPluginDescriptor;
begin
  // collect imported plug-ins (exclude duplicates)
  publicImportsMap := TStrIntfHashMap.Create; //<plug-in ID, PluginDescriptor>
  privateImportsMap := TStrIntfHashMap.Create; //<plug-in ID, PluginDescriptor>

  it := getPluginDescriptor.getPrerequisites.First;
  while it.HasNext do
  begin
    Supports(it.Next, IPluginPrerequisite, pre);
    preDescr := getPluginDescriptor.getRegistry
          .getPluginDescriptor(pre.getPluginId);
    if pre.isExported then
      publicImportsMap.PutValue(preDescr.getId, preDescr)
    else
      privateImportsMap.PutValue(preDescr.getId, preDescr);
  end;

  SetLength(publicImports, publicImportsMap.Size);
  I := 0;
  it1 := publicImportsMap.Values.First;
  while it1.HasNext do
  begin
    Supports(it1.Next, IPluginDescriptor, publicImports[I]);
    Inc(I);
  end;

  SetLength(privateImports, privateImportsMap.Size);
  I := 0;
  it1 := privateImportsMap.Values.First;
  while it1.HasNext do
  begin
    Supports(it1.Next, IPluginDescriptor, privateImports[I]);
    Inc(I);
  end;
end;

function TStandardPluginLoader.findResource(name: string; requestor:
    TStandardPluginLoader; seen: IStrSet): string;
var
  I: Integer;
begin
  log.debug('findResource(String,...): name=' + name //$NON-NLS-1$
          + ', self=' + Self.ClassName); //$NON-NLS-1$
  if ((seen <> nil) and seen.contains(getPluginDescriptor.getId)) then
    Exit;

//  Result := super.findResource(name);
//  if (Result != null) { // found resource in this plug-in class path
//      if (isResourceVisible(name, Result, requestor)) {
//          return Result;
//      }
//      return null;
//  }
  if (resourceLoader <> nil) then
  begin
    Result := resourceLoader.findResource(name);
    if (Result <> '') then // found resource in this plug-in resource libraries
    begin
      if not (isResourceVisible(name, Result, requestor)) then
        Result := '';
      Exit;
    end;
  end;
  if (seen = nil) then
    seen := TStrHashSet.Create;
  seen.add(getPluginDescriptor.getId);

  for I := 0 to Length(publicImports) - 1 do
  begin
    if seen.Contains(publicImports[i].getId) then
      Continue;
    Result := TStandardPluginLoader(getPluginManager.getPluginLoader(publicImports[i])).findResource(
                      name, requestor, seen);
    if (Result <> '') then
        Break; // found resource in publicly imported plug-in   
  end;


  if ((Self = requestor) and (Result = '')) then
  begin
      for I := 0 to Length(privateImports) - 1 do
      begin
          if (seen.contains(privateImports[i].getId)) then
              continue;

          Result := TStandardPluginLoader(getPluginManager
                  .getPluginLoader(privateImports[i])).findResource(
                          name, requestor, seen);
          if (Result <> '') then
              Break; // found resource in privately imported plug-in
      end;
  end;
end;

function TStandardPluginLoader.findResource(name: string): string;
begin
  log.debug('findResource(String): name=' + name); //$NON-NLS-1$
  Result := findResource(name, Self, nil);
  log.debug('findResource(String): Result=' + Result); //$NON-NLS-1$
end;

function TStandardPluginLoader.getUrls(manager: TPluginManager; descr:
    IPluginDescriptor): IStrList;
var
  it: IIntfIterator;
  it2: IStrIterator;
  lib: ILibrary;
  buf: string;
begin
  Result := TStrLinkedList.Create;
  it := descr.getLibraries.First;
  while it.HasNext do
  begin
    Supports(it.Next, ILibrary, lib);
//    lib := ILibrary(it.Next);
    if not lib.isCodeLibrary then
      continue;
    Result.Add(manager.getPathResolver.resolvePath(lib, lib.getPath));
  end;
  if (log.isDebugEnabled) then
  begin
    buf := 'Code URL''s populated for plug-in ' //$NON-NLS-1$
            + descr.getId + ':' + CrLf; //$NON-NLS-1$
    it2 := Result.First;
    while it.HasNext do
    begin
      buf := buf + '  ';
      buf := buf + it2.Next;
      buf := buf + CrLf;
    end;
    //log.trace(buf);
    log.info(buf);
  end;
end;

function TStandardPluginLoader.getUrls(manager: TPluginManager; descr:
    IPluginDescriptor; existingUrls: IStrList): IStrList;
var
  ResultList: IStrList;
  it: IIntfIterator;
  lib: ILibrary;
  url: string;
begin
  ResultList := TStrLinkedList.Create;
  it := descr.getLibraries.First;
  while it.HasNext do
  begin
    Supports(it.Next, ILibrary, lib);
//    lib := ILibrary(it.Next);
    if not lib.isCodeLibrary then
      Continue;
    url := manager.getPathResolver.resolvePath(lib, lib.getPath);
    if not existingUrls.Contains(url) then
      Result.Add(url);
  end;
end;

function TStandardPluginLoader.isResourceVisible(name: string; url: string;
    requestor: TStandardPluginLoader): Boolean;
var
  libFile: string;
  filter: TResourceFilter;
begin
  log.debug('isResourceVisible(URL, PluginClassLoader): URL=' + url //$NON-NLS-1$
          + ', requestor=' + requestor.ClassName); //$NON-NLS-1$
  if (self = requestor) then
  begin
    Result := true;
    Exit;
  end;
  
  libFile := Rcl.Str.SubString(url, 1, Length(url) - Length(name));
  filter := TResourceFilter(resourceFilters.Items[libFile]);
  if (filter = nil) then
    if Rcl.Str.EndsWith(libFile, '/') or Rcl.Str.EndsWith(libFile, '\') then
    begin
      libFile := Rcl.Str.SubString(libFile, 1, Length(libFile) - 1);
      filter := TResourceFilter(resourceFilters.Items[libFile]);
    end;
  if (filter = nil) then
    Result := false
  else
    Result := filter.isResourceVisible(name);
end;

function TStandardPluginLoader.newPluginInstance: IPluginInfo;
begin
  if FPluginInfo <> nil then
  begin
    Result := FPluginInfo as IPluginInfo;
    Exit;
  end;
  
  if libHandle = 0 then
  begin
    if not FileExists(libUrl) then
      raise EPluginLoader.Create(libUrl + ' is not a file path or the file is not exist!');

    if not Rcl.Str.IsEqual(ExtractFileExt(libUrl), '.dll') then
      raise EPluginLoader.Create(ExtractFileExt(libUrl) + ' is not supported!');

    libHandle := LoadLibrary(PChar(libUrl));
    if LibHandle = 0 then
      raise EPluginLoader.CreateResFmt(@RsEPluginPackageNotFound, [libUrl]);

    // Load the registration procedure
    RegisterProc := GetProcAddress(LibHandle, C_REGISTER_PLUGIN);
    if not Assigned(RegisterProc) then
      raise EPluginLoader.CreateResFmt(@RsERegisterPluginNotFound, [C_REGISTER_PLUGIN, libUrl]);

    ExitProcedure := GetProcAddress(LibHandle, C_UNREGISTER_PLUGIN);
    if not Assigned(RegisterProc) then
      raise EPluginLoader.CreateResFmt(@RsERegisterPluginNotFound, [C_UNREGISTER_PLUGIN, libUrl]);
  end;
  FPluginInfo := TPluginInfo.Create(RegisterProc);

  Result := FPluginInfo as IPluginInfo;
//  Result.setPluginLoader(Self);
end;

procedure TStandardPluginLoader.pluginsSetChanged;
begin

end;

procedure TStandardPluginLoader.setProbeParentLoaderLast(value: Boolean);
begin
  probeParentLoaderLast := value;
end;

constructor TPluginResourceLoader.Create(urls: IStrList);
begin
  log := DPFLog.LogFactory.getLogger(Self);
  ucp := TStrLinkedList.Create(urls);
end;

destructor TPluginResourceLoader.Destroy;
begin
  inherited;
  // TODO -cMM: TPluginResourceLoader.Destroy default body inserted
end;

function TPluginResourceLoader.findResource(name: string): string;
var
  it: IStrIterator;
begin
  it := ucp.First;
  while it.HasNext do
  begin
    Result := Rcl.FileUtils.IncludeSlash(it.Next) + name;
    if Rcl.FileUtils.IsFile(Result) then
      Exit;
  end;
  Result := '';
end;

class function TPluginResourceLoader.get(manager: TPluginManager; descr:
    IPluginDescriptor): TPluginResourceLoader;
var
  urls: IStrList;
  it: IIntfIterator;
  it1: IStrIterator;
  lib: ILibrary;
  buf: string;    
  log: ILog;
begin
  Result := nil;
  urls := TStrLinkedList.Create;
  it := descr.getLibraries.First;
  while it.HasNext do
  begin
    Supports(it.Next, ILibrary, lib);
    if lib.isCodeLibrary then
      Continue;
    urls.Add(manager.getPathResolver.resolvePath(lib,
              lib.getPath));
  end;

  log := DPFLog.LogFactory.getLogger(TPluginResourceLoader);

  if log.isDebugEnabled then
  begin
      buf := 'Resource URL''s populated for plug-in ''' + descr.getId //$NON-NLS-1$
              + CRLF; //$NON-NLS-1$
      it1 := urls.First;
      while it1.HasNext do
      begin
        buf := buf + '  ' + it1.Next + CRLF;
      end;
      log.Debug(buf);    
  end;
  if (urls.isEmpty) then
  begin
    Exit;
  end;
  Result := TPluginResourceLoader.Create(urls);
end;

constructor TResourceFilter.Create(lib: ILibrary);
var
  it: IStrIterator;
  exportPrefix: string;
begin
  entries := TStrHashSet.Create;
  it := lib.getExports.First;
  while it.HasNext do
  begin
    exportPrefix := it.Next;
    if Rcl.Str.IsEqual('*', exportPrefix) then
    begin
      isPublic := True;
      entries.Clear;
      Break;
    end;
    if (not lib.isCodeLibrary) then
    begin
      Rcl.Str.Replace(exportPrefix, '\\', '.');
      Rcl.Str.Replace(exportPrefix, '/', '.');
      if Rcl.Str.StartsWith(exportPrefix, '.') then //$NON-NLS-1$
        exportPrefix := Rcl.Str.SubString(exportPrefix, 2);
    end;
    entries.add(exportPrefix);
  end;
end;

function TResourceFilter.isResourceVisible(resPath: string): Boolean;
begin
  // quick check
  if isPublic then
  begin
    Result := true;
    Exit;
  end;

  if (entries.isEmpty) then
  begin
    Result := false;
    Exit;
  end;
  
  // translate 'path spec' -> 'full class name'
  Rcl.Str.Replace(resPath, '\\', '.');
  Rcl.Str.Replace(resPath, '/', '.');
  if Rcl.Str.StartsWith(resPath, '.') then //$NON-NLS-1$
      resPath := Rcl.Str.SubString(resPath, 2);
  
  if Rcl.Str.EndsWith(resPath, '.') then //$NON-NLS-1$
      resPath := Rcl.Str.SubString(resPath, 1, Length(resPath) - 1);
  
  Result := isVisible(resPath);
end;

function TResourceFilter.isVisible(name: string): Boolean;
var
  p: Integer;
begin
  // quick check
  if isPublic then
  begin
    Result := true;
    Exit;
  end;

  if entries.IsEmpty then
  begin
    Result := false;
    Exit;
  end;
      
  if entries.Contains(name) then
  begin
    Result := true;
    Exit;
  end;

  p := Rcl.Str.LastPos('.', name);
  if (p <= 0) then
    Result := false
  else 
    Result := entries.contains(Rcl.Str.SubString(name, p-1) + '.*'); //$NON-NLS-1$
end;

end.
